home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / astrolog.arc / ASTROLOG.BAS (.txt)
Encoding:
GW-BASIC  |  1986-02-01  |  22.4 KB  |  632 lines
  1. 100  CLEAR :DEFDBL A-H,J-Z:DEFINT I
  2. 105  KEY OFF
  3. 106  INPUT" NAME OF OUTPUT FILE FOR PARALLEL OUTPUT. PRN FOR PRINTER ";PAROUT$
  4. 110  CL$=CHR$(12) 'CLEAR SCREEN
  5. 111  BS$=CHR$(29)  'BACKSPACE ON SCREEN
  6. 113  DEF FNL$(A$)=CHR$(ASC(A$+" ")AND(&H5F OR (ASC(A$+" ")<&H60))) 'lower case to upper
  7. 120  PI=3.14159 
  8. 130  NP=15:'SUN,MOON,EIGHT PLANETS, AND THE NODE
  9. 140  DIM PN$(18),K(11):'PLANET NAMES
  10. 150  DIM PP(18):'PLANET POSITIONS
  11. 160  DIM PD(18):'PLANET DECLINATION
  12. 170  DIM PM(18):'PLANET MOTION
  13. 175  DIM PC(18) 'MIDPOINTS
  14. 180  DIM T(3)
  15. 190  DIM CU(12),CU$(12):'THE TWELVE PLACIDUS CUSPS
  16. 200  DIM PS(30,6):'SORTED HOUSES & PLANETS
  17. 210  PN$(1)="SUN    ":PN$(2)="MOON   ":PN$(3)="MERCURY"
  18. 220  PN$(4)="VENUS  ":PN$(5)="MARS   ":PN$(6)="JUPITER"
  19. 230  PN$(7)="SATURN ":PN$(8)="URANUS ":PN$(9)="NEPTUNE"
  20. 240  PN$(10)="PLUTO  ":PN$(11)="N NODE ":PN$(12)="CERES  "
  21. 250  PN$(13)="PALLAS ":PN$(14)="JUNO   ":PN$(15)="VESTA  "
  22. 260  CU$(1)="ASCENDANT ":CU$(7)="7TH HOUSE "
  23. 270  CU$(2)="2ND HOUSE ":CU$(8)="8TH HOUSE "
  24. 280  CU$(3)="3RD HOUSE ":CU$(9)="9TH HOUSE "
  25. 290  CU$(4)="4TH HOUSE ":CU$(10)="MIDHEAVEN "
  26. 300  CU$(5)="5TH HOUSE ":CU$(11)="11TH HOUSE"
  27. 310  CU$(6)="6TH HOUSE ":CU$(12)="12TH HOUSE"
  28. 320  '************************** MAIN ROUTINE *************
  29. 330  PRINT CL$;:PRINT"**ASTROLOGY** 5/05/85 VERS 3.1   BY RICHARD NARRON
  30. 340  PRINT "     ( PLANETARY ROUTINES BY JAMES NEELY AND MICHAEL ERLEWINE )"
  31. 350  PRINT"TYPE THE CODE LETTER THAT MATCHES THE FUNCTION TO BE PERFORMED"
  32. 360  PRINT:PRINT TAB(10);"CODE";TAB(20);"FUNCTION"
  33. 370  PRINT TAB(10);"----";TAB(20);"--------"
  34. 380  PRINT TAB(12);"N";TAB(20);"COMPUTE A NATAL CHART"
  35. 390  PRINT TAB(12);"L";TAB(20);"TURN PARALLEL OUTPUT ON/OFF  FILE=";PAROUT$
  36. 400  PRINT TAB(12);"H";TAB(20);"LIST HOUSES AND GENERAL INFORMATION"
  37. 410  PRINT TAB(12);"P";TAB(20);"LIST PLANETS POSITIONS"
  38. 420  PRINT TAB(12);"A";TAB(20);"LIST ASPECTS"
  39. 430  PRINT TAB(12);"S";TAB(20);"LIST SORTED PLANETS & HOUSES"
  40. 440  PRINT TAB(12);"M";TAB(20);"LIST MIDPOINTS"
  41. 450  PRINT TAB(12);"F";TAB(20);"LIST FILES ON DISK"
  42. 460  PRINT TAB(12);"W";TAB(20);"WRITE NATAL DATA TO DISK"
  43. 470  PRINT TAB(12);"R";TAB(20);"READ NATAL DATA FROM DISK"
  44. 480  PRINT TAB(12);"E"TAB(20);"END THE PROGRAM"
  45. 490  A$=INKEY$:IF A$="" THEN 490
  46. 495  A$=FNL$(A$) 'convert to lower case
  47. 500  PRINT CL$ 'clear screen
  48. 510  IF A$="N" THEN GOSUB 630  :GOTO 330
  49. 520  IF A$="L" THEN GOSUB 770  :GOTO 330
  50. 530  IF A$="H" THEN GOSUB 2940 :GOSUB 740  :GOTO 330
  51. 540  IF A$="P" THEN GOSUB 690  :GOTO 330
  52. 550  IF A$="A" THEN GOSUB 710  :GOTO 330
  53. 560  IF A$="S" THEN GOSUB 5720 :GOTO 330
  54. 570  IF A$="M" THEN GOSUB 6020:GOTO 330
  55. 580  IF A$="F" THEN GOSUB 6230 :GOTO 330
  56. 590  IF A$="W" THEN GOSUB 5400 :GOTO 330
  57. 600  IF A$="R" THEN GOSUB 5550 :GOTO 330
  58. 610  IF A$="E" THEN RESET :ON ERROR GOTO 0:KEY ON:GOTO 730
  59. 620  GOTO 330
  60. 630  PRINT"COMPUTE A NATAL CHART":PRINT"PLEASE ANSWER A FEW QUESTIONS":PRINT
  61. 640  GOSUB 800  :'GET INPUT DATA
  62. 650  GOSUB 1720 :'COMPUTE JUL DAYS, GMT DATE, SIDERIAL TIME ETC.
  63. 660  GOSUB 2940 :'PRINT GENERAL INFO AND HOUSES
  64. 670  GOSUB 4510 :GOSUB 740  :'COMPUTE PLANETS POSITIONS AND WAIT
  65. 680  RETURN
  66. 690  GOSUB 3240 :GOSUB 740  :'LIST PLANET POSITIONS AND WAIT
  67. 700  RETURN
  68. 710  GOSUB 3390 :GOSUB 740  :'COMPUTE AND LIST ASPECTS AND WAIT
  69. 720  RETURN
  70. 730  CLOSE:SYSTEM '*********************** END OF PROGRAM ******
  71. 740  PRINT "<<PRESS ANY KEY>>"
  72. 750  A$=INKEY$:IF A$="" THEN 750:ELSE RETURN
  73. 760  FOR I=1 TO 100:NEXT:GOTO 740
  74. 770  IF LP=1 THEN LP=0:PRINT "PARALLEL OUTPUT IS NOW OFF":CLOSE 2 :GOTO 740
  75. 772  IF LP=0 THEN LP=1 :PRINT "PARALLEL OUTPUT IS NOW ON":OPEN PAROUT$ FOR OUTPUT AS #2
  76. 780  GOTO 740
  77. 800  PRINT"Note: questions with (y/n) answers default to: y":PRINT
  78. 805  INPUT"SUBJECT'S NAME";NA$
  79. 810  PRINT"WAS ";NA$;" BORN DURING DAYLIGHT SAVINGS (y/n)";
  80. 820  A$="":INPUT A$:IF LEFT$(FNL$(A$),1)="N" THEN DS$="STANDARD":ELSE DS$="DAYLIGHT"
  81. 830  PRINT"TIME (7:23:21AM)? ";:HO=0:MI=0:SE=0
  82. 840  A$="":GOSUB 850  :GOTO 880  
  83. 850  GOSUB 870  :X=ASC(B$):PRINT B$;:IF X=8 OR X=13 THEN 860  ELSE A$=A$+B$:GOTO 850  
  84. 860  IF X=13 THEN RETURN:ELSE IF LEN(A$)=0 THEN GOTO 850 :ELSE A$=LEFT$(A$,LEN(A$)-1):GOTO 850  
  85. 870  B$=INKEY$:IF B$="" THEN 870  :ELSE RETURN
  86. 880  HO=VAL(A$)
  87. 890  FOR I=1 TO LEN(A$)
  88. 900          B$=FNL$(MID$(A$,I,1))
  89. 910      IF B$="A" OR B$="P" THEN 1080  
  90. 920      IF B$=":" THEN A$=RIGHT$(A$,LEN(A$)-I):GOTO 950  
  91. 930  NEXT I
  92. 940  GOTO 1070  
  93. 950  MI=VAL(A$)
  94. 960  FOR I=1 TO LEN(A$)
  95. 970      B$=FNL$(MID$(A$,I,1))
  96. 980      IF B$="A" OR B$="P" THEN 1080  
  97. 990      IF B$=":" THEN A$=RIGHT$(A$,LEN(A$)-I):GOTO 1020  
  98. 1000  NEXT I
  99. 1010  GOTO 1070  
  100. 1020  SE=VAL(A$)
  101. 1030  FOR I=1 TO LEN(A$)
  102. 1040     B$=FNL$(MID$(A$,I,1))
  103. 1050     IF B$="A" OR B$="P" THEN 1080  
  104. 1060  NEXT I
  105. 1070  GOTO 830  
  106. 1080  LT$=B$
  107. 1090  LT=HO+MI/60+SE/3600:IF HO<0 OR HO>23 OR MI<0 OR MI>59 OR SE<0 OR SE>59 OR LT<0 THEN 830  
  108. 1100  PRINT:LT=LT+(DS$="DAYLIGHT")-12*(LT$="P" AND HO<12)+12*(LT$="A" AND HO=12)
  109. 1110  GOSUB 1120:GOTO 1300
  110. 1120  INPUT"DATE (3/21/81)";A$
  111. 1130  MO=0:DA=0:YE=0:MO=VAL(A$):FOR I=1 TO LEN(A$):IF MID$(A$,I,1)="/"THEN A$=RIGHT$(A$,LEN(A$)-I):GOTO 1160  
  112. 1140  NEXT I
  113. 1150  GOTO 1120  
  114. 1160  DA=VAL(A$):FOR I=1 TO LEN(A$):IF MID$(A$,I,1)="/"THEN A$=RIGHT$(A$,LEN(A$)-I):GOTO 1190 
  115. 1170  NEXT I
  116. 1180  GOTO 1120  
  117. 1190  IF LEN(A$)=0 THEN 1120  
  118. 1200  YE=VAL(A$)
  119. 1210  IF YE<100 THEN YE=YE+1900
  120. 1220  IF YE<1900 OR YE>2000 THEN 1120  
  121. 1230  IF MO<1 OR MO>12 THEN 1120  
  122. 1240  IF DA<1 OR DA>31 THEN 1120  
  123. 1250  IF DA=31 AND (MO=2 OR MO=4 OR MO=6) THEN 1120  
  124. 1260  IF DA=31 AND (MO=9 OR MO=11) THEN 1120  
  125. 1270  IF MO=2 AND DA>29 THEN 1120  
  126. 1280  IF MO=2 AND DA=29 AND (YE=1900 OR YE-INT(YE/4)*4<>0)THEN 1120  
  127. 1290  RETURN
  128. 1300  PRINT:PRINT"PLEASE CHECK THESE:":PRINT"NAME"TAB(21)NA$
  129. 1310  PRINT"LOCAL ";DS$;" TIME"TAB(20)HO;":";MI;":";SE;LT$;"M"
  130. 1320  PRINT "DATE"TAB(20)MO"/"DA"/"YE
  131. 1330  A$="":INPUT"DO THESE LOOK OK (y/n)";A$:A$=FNL$(A$)
  132. 1340  IF LEFT$(A$,1)="N" THEN PRINT"LETS TRY AGAIN..." :GOTO 800  
  133. 1350  GOSUB 1360 :GOTO 1470 
  134. 1360  INPUT"PLACE";PL$
  135. 1370  INPUT"LATITUDE (40N43)";A$:IF A$="" THEN 1370
  136. 1372  FOR I=1 TO LEN(A$):MID$(A$,I,1)=FNL$(MID$(A$,I,1)):NEXT
  137. 1380  AD=VAL(A$):FOR I=1 TO LEN(A$):LA$=MID$(A$,I,1):IF LA$="N" OR LA$="S" THEN A$=MID$(A$,I+1,LEN(A$)-I):GOTO 1410
  138. 1390  NEXT I
  139. 1400  GOTO 1370 
  140. 1410  AM=VAL(A$)
  141. 1420  IF AD<0 OR AD>90 OR AM<0 OR AM>59 THEN 1370 
  142. 1430  LA=AD+AM/60
  143. 1440  IF LA>90 THEN PRINT"THAT LATITUDE IS TOO HIGH!":GOTO 1370 
  144. 1450  IF LA$="S" THEN LA=-1*LA
  145. 1460  RETURN
  146. 1470  INPUT"LONGITUDE (74W00)";A$:IF A$="" THEN 1470
  147. 1472  FOR I=1 TO LEN(A$):MID$(A$,I,1)=FNL$(MID$(A$,I,1)):NEXT
  148. 1480  FOR I=1 TO LEN(A$):IF MID$(A$,I,1)="E" THEN A$=LEFT$(A$,I-1)+"M"+RIGHT$(A$,LEN(A$)-I):GOTO 1490 :ELSE NEXT I
  149. 1490  BD=VAL(A$):FOR I=1 TO LEN(A$):LO$=MID$(A$,I,1):IF LO$="W" OR LO$="M" THEN A$=MID$(A$,I+1,LEN(A$)-I):GOTO 1520 
  150. 1500  NEXT I
  151. 1510  GOTO 1470 
  152. 1520  BM=VAL(A$)
  153. 1530  IF BD<0 OR BD>180 THEN 1470 
  154. 1540  IF BM<0 OR BM>59 THEN 1470 
  155. 1550  LO=BD+BM/60
  156. 1560  IF LO>180 THEN PRINT"THAT LONGITUDE IS TOO HIGH!":GOTO 1470 
  157. 1570  IF LO$="W" THEN LO=-1*LO
  158. 1580  IF LO$="M" THEN LO$="E"
  159. 1590  PRINT:PRINT"PLACE"TAB(21)PL$
  160. 1600  PRINT"LATITUDE"TAB(20)AD;LA$;AM
  161. 1610  PRINT"LONGITUDE"TAB(20)BD;LO$;BM
  162. 1620  A$="":INPUT"DO THE PLACE, LATITUDE, AND LONGITUDE LOOK OK (y/n)";A$:A$=FNL$(A$)
  163. 1630  IF LEFT$(A$,1)="N" THEN 1350 
  164. 1640  IF LO$="W" THEN A=-1 ELSE A=1
  165. 1650  A=A*INT((ABS(LO)+7.5)/15)
  166. 1660  PRINT"IS THE TIME ZONE ";A;"HOURS DIFFERENT FROM GREENWICH (y/n)";
  167. 1670  A$="":INPUT A$:A$=FNL$(A$)
  168. 1680  IF LEFT$(A$,1)="N" THEN INPUT"WHAT IS THE DIFFERENCE";A
  169. 1690  GT=LT-A:'GREENWICH TIME
  170. 1700  INPUT"WHAT HOUSE SYSTEM? PLACIDUS OR KOCH (p/k)";A$:A$=FNL$(LEFT$(A$,1)):HS=1:IF A$="K" THEN HS=2
  171. 1710  RETURN
  172. 1720  GOSUB 1730:GOSUB 1790:GOSUB 1820:RETURN
  173. 1730  M=MO:D=DA:Y=YE:GOSUB 1960:JD=X 'COMPUTE JULIAN DAYS
  174. 1740  IF GT<0 THEN GT=GT+24:JD=JD-1:GOTO 1740
  175. 1750  IF GT>24 THEN GT=GT-24:JD=JD+1:GOTO 1750 
  176. 1760  X=JD:GOSUB 2030 :GM=M:GD=D:GY=Y:'COMPUTE GREENWICH DATE
  177. 1770  TC=((JD-2.41502E+06)+GT/24-0.5)/36525:'CENTURY INCREMENT
  178. 1780  RETURN
  179. 1790  GOSUB 2200 :'COMPUTE SIDERIAL TIME
  180. 1800  OB=(23.4523-0.0130125*TC)*PI/180 'ECLIPTIC OBLIQUITY
  181. 1810  RETURN
  182. 1820  S=ST:L=LA:'COMPUTE PLACIDUS CUSPS
  183. 1830  FOR I=1 TO 6
  184. 1840    N=I
  185. 1850    IF HS=0 THEN HS=1
  186. 1860    IF HS=1 THEN GOSUB 2700:'PLACIDUS HOUSES
  187. 1870    IF HS=2 THEN GOSUB 2570:'KOCH HOUSE
  188. 1880    IF HS=2 THEN N=I+9
  189. 1890    IF N>12 THEN N=N-12
  190. 1900    CU(N)=K
  191. 1910    N=N+6:IF N>12 THEN N=N-12
  192. 1920    CU(N)=(K+180)-INT((K+180)/360)*360
  193. 1930  NEXT I
  194. 1940  RI=CU(1):MC=CU(10):'GET ASCENDANT AND MIDHEAVEN
  195. 1950  RETURN
  196. 1960  'SUBROUTINE JULIAN DAYS (X) CREATED FROM (M,D,Y)
  197. 1970  A1=Y
  198. 1980  A2=D+365*A1
  199. 1990  IF M>=3 THEN A2=A2-INT(0.4*M+2.3):A1=A1+1
  200. 2000  X=A2+31*M+INT((A1-1)/4)-INT((A1-1)/100)+INT((A1-1)/400)
  201. 2010  X=X+1.72103E+06
  202. 2020  RETURN
  203. 2030  'SUBROUTINE DATE (M,D,Y) CREATED FROM JULIAN DAYS (X)
  204. 2040  X2=X-1.72103E+06
  205. 2050  Y=INT(X2/365)
  206. 2060  X1=X2-Y*365-INT(Y/4)+INT(Y/100)-INT(Y/400)
  207. 2070  M=INT(X1/31)
  208. 2080  D=X1-M*31+INT(0.4*M+2.3)
  209. 2090  IF D>31 THEN M=M+1:GOTO 2080 
  210. 2100  IF D=31 AND ((M=4) OR (M=6) OR (M=9) OR (M=11)) THEN M=M+1:   GOTO 2080 
  211. 2110  IF M<3 THEN Y=Y-1:GOTO 2060 
  212. 2120  IF M>12 THEN M=M-12:Y=Y+1
  213. 2130  RETURN
  214. 2140  'SUBROUTINE TIME (H,M,S) CREATED FROM TIME (T)
  215. 2150  T1=T+1/7200
  216. 2160  H=FIX(T1)
  217. 2170  T1=T1-H:M=FIX(T1*60)
  218. 2180  T1=T1-M/60:S=FIX(T1*3600)
  219. 2190  RETURN
  220. 2200  'SUBROUTINE SIDERIAL TIME (ST) FROM (TC,GT,LO)
  221. 2210  ST=(6.64607+2400.05*TC+2.5798E-05*TC*TC+GT)*15+LO
  222. 2220  ST=ST-INT(ST/360)*360:ST=ST/15
  223. 2230  RETURN
  224. 2240  'SUBROUTINE SIGN (S$) CREATED FROM (S)
  225. 2250  S1=S/30
  226. 2260  S2=INT(S1)
  227. 2270  S3=(S1-S2)*30
  228. 2280  S4=FIX((S3-INT(S3))*60)
  229. 2290  IF S2=0 THEN S$="ARI"
  230. 2300  IF S2=1 THEN S$="TAU"
  231. 2310  IF S2=2 THEN S$="GEM"
  232. 2320  IF S2=3 THEN S$="CAN"
  233. 2330  IF S2=4 THEN S$="LEO"
  234. 2340  IF S2=5 THEN S$="VIR"
  235. 2350  IF S2=6 THEN S$="LIB"
  236. 2360  IF S2=7 THEN S$="SCO"
  237. 2370  IF S2=8 THEN S$="SAG"
  238. 2380  IF S2=9 THEN S$="CAP"
  239. 2390  IF S2=10 THEN S$="AQU"
  240. 2400  IF S2=11 THEN S$="PIS"
  241. 2410  S$=STR$(INT(S3))+" "+S$+STR$(INT(S4)):IF MID$(S$,3,1)=" " THEN S$=" 0"+MID$(S$,2)
  242. 2420  RETURN
  243. 2430  'SUBROUTINE ANGLE (S) CREATED FROM SIGN (S$)
  244. 2440  IF LEFT$(S$,2)="AR" THEN S=0
  245. 2450  IF LEFT$(S$,1)="T"  THEN S=30
  246. 2460  IF LEFT$(S$,1)="G"  THEN S=60
  247. 2470  IF LEFT$(S$,3)="CAN"THEN S=90
  248. 2480  IF LEFT$(S$,2)="LE" THEN S=120
  249. 2490  IF LEFT$(S$,1)="V"  THEN S=150
  250. 2500  IF LEFT$(S$,2)="LI" THEN S=180
  251. 2510  IF LEFT$(S$,2)="SC" THEN S=210
  252. 2520  IF LEFT$(S$,2)="SA" THEN S=240
  253. 2530  IF LEFT$(S$,3)="CAP"THEN S=270
  254. 2540  IF LEFT$(S$,2)="AQ" THEN S=300
  255. 2550  IF LEFT$(S$,1)="P" THEN S=330
  256. 2560  RETURN
  257. 2570  'SUBROUTINE KOCH CUSPS (K) FROM HOUSE,LATITUDE,SIDERIAL-TIME (N,L,S)
  258. 2580  S=ST*PI/12:L=LA*PI/180:W=SIN(S)*TAN(L)*TAN(OB):GOSUB 2840:'ARCSIN(W)
  259. 2590  IF N=1 THEN X1=S-W
  260. 2600  X2=PI/2+W
  261. 2610  S1=X2/3
  262. 2620  N1=ATN(TAN(L)/COS(X1))
  263. 2630  L1=N1+OB
  264. 2640  K=ATN(COS(N1)*TAN(X1)/COS(L1))
  265. 2650  IF K<0 THEN K=K+PI
  266. 2660  IF SIN(X1)<0 THEN K=K+PI
  267. 2670  X1=X1+S1
  268. 2680  K=K*180/PI:K=K-INT(K/360)*360
  269. 2690  RETURN
  270. 2700  'SUBROUTINE PLACIDUS CUSPS (K) FROM HOUSE,LATITUDE,SIDERIAL-TIME (N,L,S)
  271. 2710  C=PI/180
  272. 2720  N1=(ABS(N-7)-3)/3
  273. 2730  S1=S*15*C
  274. 2740  T=(N+2)*30*C
  275. 2750  L1=L*C :X1=1
  276. 2760  W=SIN(X1)*TAN(OB)*TAN(L1)
  277. 2770  GOSUB 2840 
  278. 2780  X2=N1*W+S1+T
  279. 2790  IF ABS(X2-X1)>0.000999999 THEN X1=X2:GOTO 2760 
  280. 2800  IF X2-PI/2<9.999E-06 THEN K=90: GOTO 2830 
  281. 2810  K=ATN(TAN(X2)/COS(OB))/C-FIX((X2/C+90)/180)*180
  282. 2820  K=K-INT(K/360)*360
  283. 2830  RETURN
  284. 2840  'SUBROUTINE ARCSIN (W)
  285. 2850  IF W=-1 THEN W=-PI/2:GOTO 2880 
  286. 2860  IF W=1 THEN W=PI/2:GOTO 2880 
  287. 2870  W=ATN(W/SQR(1-W*W))
  288. 2880  RETURN
  289. 2890  'SUBROUTINE ARCCOS (W)
  290. 2900  IF W=-1 THEN W=PI:GOTO 2930 
  291. 2910  IF W=1 THEN W=0:GOTO 2930 
  292. 2920  W=-ATN(W/SQR(-W*W+1))+PI/2
  293. 2930  RETURN
  294. 2940  'PRINT HOUSE AND OTHER INFO
  295. 2950  IF LP=1 THEN PRINT #2, " ":PRINT #2, " "
  296. 2960  PRINT"NAME";TAB(31);NA$
  297. 2970  IF LP=1 THEN PRINT #2, "NAME";TAB(31);NA$
  298. 2980  PRINT"DATE";TAB(30);MO;"/";DA;"/";YE
  299. 2990  IF LP=1 THEN PRINT #2, "DATE";TAB(30);MO;"/";DA;"/";YE
  300. 3000  PRINT"LOCAL ";DS$;" TIME";TAB(30);HO;":";MI;":";SE;LT$;"M"
  301. 3010  IF LP=1 THEN PRINT #2, "LOCAL ";DS$;" TIME";TAB(30);HO;":";MI;":";SE;LT$;"M"
  302. 3020  PRINT"PLACE";TAB(31);PL$
  303. 3030  IF LP=1 THEN PRINT #2, "PLACE";TAB(31);PL$
  304. 3040  PRINT"LATITUDE";TAB(30);AD;LA$;AM
  305. 3050  IF LP=1 THEN PRINT #2, "LATITUDE";TAB(30);AD;LA$;AM
  306. 3060  PRINT"LONGITUDE";TAB(30);BD;LO$;BM
  307. 3070  IF LP=1 THEN PRINT #2, "LONGITUDE";TAB(30);BD;LO$;BM
  308. 3080  T=GT:GOSUB 2140 :PRINT"GREENWICH MEAN TIME IS"TAB(30);H;":";M;":";S
  309. 3090  IF LP=1 THEN PRINT #2, "GREENWICH MEAN TIME IS"TAB(30);H;":";M;":";S
  310. 3100  T=ST:GOSUB 2140 :PRINT"SIDERIAL TIME IS"TAB(30);H;":";M;":";S
  311. 3110  IF LP=1 THEN PRINT #2, "SIDERIAL TIME IS"TAB(30);H;":";M;":";S
  312. 3120  'PRINT PLACIDUS OR KOCH CUSPS
  313. 3130  IF HS=2 THEN PRINT "KOCH CUSPS:":ELSE PRINT "PLACIDUS CUSPS:"
  314. 3140  IF LP=1 THEN IF HS=2 THEN PRINT #2, "KOCH CUSPS:":ELSE PRINT #2, "PLACIDUS CUSPS:"
  315. 3150  FOR I=1 TO 6
  316. 3160     S=CU(I):GOSUB 2240 
  317. 3170     PRINT CU$(I)+" "+S$;TAB(31)
  318. 3180     IF LP=1 THEN PRINT #2, CU$(I)+" "+S$;TAB(31)
  319. 3190     S=CU(I+6):GOSUB 2240 
  320. 3200     PRINT CU$(I+6)+" "+S$ 
  321. 3210     IF LP=1 THEN PRINT #2, CU$(I+6)+" "+S$
  322. 3220  NEXT
  323. 3230  RETURN
  324. 3240  PRINT"PLANET"TAB(21)"LONGITUDE"TAB(45)"LATITUDE"
  325. 3250  IF LP=1 THEN PRINT #2,:PRINT #2,:PRINT #2, "PLANET"TAB(21)"LONGITUDE"TAB(45)"LATITUDE"
  326. 3260  FOR I=1 TO NP  'PRINT PLANETS
  327. 3270  PRINT PN$(I) TAB(20);
  328. 3280  IF LP=1 THEN PRINT #2, PN$(I) TAB(20);
  329. 3290  S=PP(I):GOSUB 2240 :PRINT S$;
  330. 3300  IF LP=1 THEN PRINT #2, S$;
  331. 3310  IF PM(I)<0 THEN PRINT" RX";:ELSE PRINT"";
  332. 3320  IF LP=1 THEN IF PM(I)<0 THEN PRINT #2," RX";:ELSE PRINT #2,"";
  333. 3330  T=ABS(PD(I)):GOSUB 2140 :PRINT TAB(44);H;:IF PD(I)>=0 THEN PRINT "N";:ELSE PRINT"S";
  334. 3340  IF LP=1 THEN PRINT #2, TAB(44);H;:IF PD(I)>=0 THEN PRINT #2, "N";:ELSE PRINT #2,"S";
  335. 3350  PRINT M;"'";S;"''"
  336. 3360  IF LP=1 THEN PRINT #2, M;"'";;S;"''"
  337. 3370  NEXT I
  338. 3380  RETURN
  339. 3390  'ASPECTS
  340. 3400  PRINT TAB(8);" SUN ";" MOON";
  341. 3410  IF LP=1 THEN PRINT #2,:PRINT #2,:PRINT #2, TAB(8);" SUN ";" MOON";
  342. 3420  FOR I=3 TO 10:PRINT " ";LEFT$(PN$(I),4);
  343. 3430  IF LP=1 THEN PRINT #2, " ";LEFT$(PN$(I),4);
  344. 3440  NEXT I:PRINT "":IF LP=1 THEN PRINT #2, 
  345. 3450  FOR I=1 TO 10
  346. 3460  PRINT PN$(I);TAB(8);
  347. 3470  IF LP=1 THEN PRINT #2, PN$(I);TAB(8);
  348. 3480  FOR I1=1 TO 10
  349. 3490  IF I1=I THEN A$="****":PRINT " ????";:GOTO 3710 
  350. 3500  PRINT " ????";
  351. 3510  K=ABS(PP(I)-PP(I1)):GOSUB 3520 :GOTO 3710 
  352. 3520  IF K>180 THEN K=ABS(K-360):GOTO 3520 
  353. 3530  IF K<0 THEN K=K+360:GOTO 3520 
  354. 3540  IF ABS(K)<=8 THEN A$="CONJ":GOTO 3700 
  355. 3550  IF ABS(K-180)<=8 THEN A$="OPOS":GOTO 3700 
  356. 3560  IF ABS(K-120)<=6 THEN A$="TRIN":GOTO 3700 
  357. 3570  IF ABS(K-90)<=5 THEN A$="SQUA":GOTO 3700 
  358. 3580  IF ABS(K-60)<=3 THEN A$="SEXT":GOTO 3700 
  359. 3590  IF ABS(K-45)<=2 THEN A$="SMSQ":GOTO 3700 
  360. 3600  IF ABS(K-135)<=2 THEN A$="SESQ":GOTO 3700 
  361. 3610  IF ABS(K-30)<=1 THEN A$="SMSX":GOTO 3700 
  362. 3620  IF ABS(K-150)<=1 THEN A$="INCJ":GOTO 3700 
  363. 3630  IF ABS(K-72)<=1.5 THEN A$="QUNT":GOTO 3700 
  364. 3640  IF ABS(K-(360/7))<=1.5 THEN A$="SEPT":GOTO 3700 
  365. 3650  IF ABS(K-40)<=1 THEN A$="NOVI":GOTO 3700 
  366. 3660  IF ABS(K-144)<=2 THEN A$="BQNT":GOTO 3700 
  367. 3670  IF ABS(K-(2*360/7))<=2 THEN A$="BSEP":GOTO 3700 
  368. 3680  IF ABS(K-(3*360/7))<=2 THEN A$="TSEP":GOTO 3700 
  369. 3690  A$="    "
  370. 3700  RETURN
  371. 3710  PRINT STRING$(5,BS$);:PRINT " ";A$;
  372. 3720  IF LP=1 THEN PRINT #2, " ";A$;
  373. 3730  NEXT I1
  374. 3740  PRINT ""
  375. 3750  IF LP=1 THEN PRINT #2, ""
  376. 3760  NEXT I
  377. 3770  PRINT:IF LP=1 THEN PRINT #2,
  378. 3780  PRINT "ASC";TAB(8);
  379. 3790  IF LP=1 THEN PRINT #2,  "ASC";TAB(8);
  380. 3800  FOR I=1 TO 10:K=ABS(RI-PP(I)):PRINT" ????";:GOSUB 3520 :PRINT STRING$(5,BS$);" ";A$;
  381. 3810  IF LP=1 THEN PRINT #2, " ";A$;
  382. 3820  NEXT I:PRINT ""
  383. 3830  IF LP=1 THEN PRINT #2, ""
  384. 3840  PRINT "MID";TAB(8);
  385. 3850  IF LP=1 THEN PRINT #2, "MID";TAB(8);
  386. 3860  FOR I=1 TO 10:K=ABS(MC-PP(I)):PRINT " ????";:GOSUB 3520 :PRINT STRING$(5,BS$);" ";A$;
  387. 3870  IF LP=1 THEN PRINT #2, " ";A$;
  388. 3880  NEXT I:PRINT ""
  389. 3890  IF LP=1 THEN PRINT #2, ""
  390. 3900  RETURN
  391. 3910  'SUN DATA
  392. 3920  DATA 358.4758,35999.0498,-.0002,.01675,-.4D-4,0,1,101.2208,1.7192,.00045,0,0,0,0,0,0
  393. 3930  'MERC 102.2974
  394. 3940  DATA 102.2794,149472.5151,0,.20561,.2D-4,0,.387098,28.7538,.3703,.0001,47.1459,1.185,.0002,7.0029,.0019,-.2E-4
  395. 3950  'VENU 212.6032
  396. 3960  DATA 212.6032,58517.8039,.0013,.00682,-.5D-4,0,.7233,54.3842,.5082,-.14D-2,75.7796,.8999,.4D-3,3.3936,.1D-2,0
  397. 3970  'MARS 319.5294
  398. 3980  DATA 319.5294,19139.8585,.2E-03,.09331,.9E-4,0,1.5237,285.4318,1.0698,.1E-3,48.7864,.77099,0,1.8503,-.7E-3,0
  399. 3990  'JUPITER
  400. 4000  DATA 225.4928125,3033.687936,0
  401. 4010  DATA .048381440,-.155E-4,0,5.202904930,273.3930152,1.338344640,0,99.41984827,1.058291520,0,1.309658500
  402. 4020  'JUPITER HARMONICS AT -.001
  403. 4030  DATA -.5156130E-2,0,-.0010,-.0005,.0045,.0051,581.6589,-9.7377,-.0005,2510.6543,-12.5381
  404. 4040  DATA -.0026,1313.7145,-61.4095,.0013,2370.7940,-24.6397,-.0013,3599.2992,37.6800,-.0010,2574.6924
  405. 4050  DATA 31.4306,-.00096,6708.1816,-114.4988,-.0006,5499.4267,-74.9716,-.0013,1419.0437,54.2159,.0006
  406. 4060  DATA 6339.2773,-109.0102,.0007,4824.4717,-50.8501,.0020,-.0134,.0127,-.0023,676.1597,.9329,.00045
  407. 4070  DATA 2361.3553,174.9531,.0015,1427.4621,-188.8358,.0006,2110.1291,153.6404,.0014,3606.8061,-57.6744
  408. 4080  DATA -.0017,2540.1554,121.7431,-.00099,6704.7824,-22.2534,-.0006,5480.1660,24.5140,.00096
  409. 4090  'SATURN AT 174.2153
  410. 4100  DATA 1651.2817,-118.2299,.0006,6310.7640,-4.8278,.0007,4826.6105,36.2451,174.2153,1223.50796
  411. 4110  DATA 0,.05423,-.2D-3,0,9.5525,338.9117,-.3167,0,112.8261,.8259,0,2.4908
  412. 4120  'SATURN HARMONICS AT -.0009
  413. 4130  DATA -.0047,0,-.0009,.0037,0,.0134,1238.9,-16.4,-.00426,3040.9,-25.2,.0064
  414. 4140  DATA 1835.3,36.1,-.0153,610.8,-44.2,-.0015,2480.5,-69.4,-.0014,.0026,0,.0111
  415. 4150  DATA 1242.2,78.3,-.0045,3034.96,62.8,-.0066,1829.2,-51.5,-.0078,640.6,24.2
  416. 4160  DATA -.0016,2363.4,-141.4,.0006,-.0002,0,-.0005,1251.1,43.7,.0005,622.8
  417. 4170  'URANUS AT 74.1757
  418. 4180  DATA 13.7,.0003,1824.7,-71.1,.0001,2997.1,78.2,74.1757,427.2742,0,.04682
  419. 4190  '8S HARMOS AT .0021
  420. 4200  DATA .00042,0,19.2215,95.6863,2.0508,0,73.5222,.5242,0,.7726,.1D-3,0,-.0021
  421. 4210  DATA -.0159,0,.0299,422.3,-17.7,-.0049,3035.1,-31.3,-.0038,945.3,60.1
  422. 4220  DATA -.0023,1227,-4.99,.0134,-.02186,0,.0317,404.3,81.9,-.00495,3037.9,57.3
  423. 4230  DATA .004,993.5,-54.4,-.0018,1249.4,79.2,-.0003,.0005,0,.0005,352.5,-54.99
  424. 4240  'P9 AT 30.13294
  425. 4250  DATA .0001,3027.5,54.2,-.0001,1150.3,-88,30.13294,240.45516,0,.00913,-.00127
  426. 4260  DATA 0,30.11375,284.1683,-21.6329,0,130.68415,1.1005,0,1.7794,-.0098,0,.1832
  427. 4270  DATA -.6718,.2726,-.1923,175.7,31.8,.0122,542.1,189.6,.0027,1219.4,178.1
  428. 4280  DATA -.00496,3035.6,-31.3,-.1122,.166,-.0544,-.00496,3035.3,58.7,.0961,177.1
  429. 4290  DATA -68.8,-.0073,630.9,51,-.0025,1236.6,78,.00196,-.0119,.0111,.0001
  430. 4300  DATA 3049.3,44.2,-.0002,893.9,48.5,.00007,1416.5,-25.2,229.781,145.1781,0
  431. 4310  DATA .24797,.002898,0,39.539,113.537,.2086,0,108.944,1.3739,0,17.1514
  432. 4320  DATA -.0161,0,-.0426,.073,-.029,.0371,372,-331.3,-.0049,3049.6,-39.2,-.0108
  433. 4330  DATA 566.2,318.3,.0003,1746.5,-238.3,-.0603,.5002,-.6126,.049,273.97,89.97
  434. 4340  DATA -.0049,3030.6,61.3,.0027,1075.3,-28.1,-.0007,1402.3,20.3,.0145,-.0928
  435. 4350  DATA .1195,.0117,302.6,-77.3,.00198,528.1,48.6,-.0002,1000.4,-46.1
  436. 4360  'CERES
  437. 4370  DATA 108.2925,7820.365556,0,.0794314,0,0,2.7672273,71.07944444
  438. 4380  DATA 0,0,80.23555556,1.396011111,0,10.59694444,0,0
  439. 4390  'PALLAS
  440. 4400  DATA 106.6641667,7806.531667,0,.2347096
  441. 4410  DATA 0,0,2.7704955,310.1661111,0,0
  442. 4420  DATA 172.4972222,1.396011111,0,34.81416667,0,0
  443. 4430  'JUNO
  444. 4440  DATA 267.685,8256.081111,0,.2562318,0,0,2.6689897
  445. 4450  DATA 245.3752778,0,0,170.1377778,1.396011111,.000308333
  446. 4460  DATA 13.0164444,0,0
  447. 4470  'VESTA
  448. 4480  DATA 138.7733333,9924.931111,0,.0902807,0,0
  449. 4490  DATA 2.360723,149.6386111,0,0,103.2197222,1.396011111
  450. 4500  DATA .000308333,7.139444444,0,0
  451. 4510  'PLANETS POSITIONS 
  452. 4520  RESTORE
  453. 4530  PRINT "I AM COMPUTING THE POSITIONS FROM THE SUN TO ";PN$(NP);".";
  454. 4540  FOR I=1 TO NP
  455. 4550  PRINT PN$(I);" ";
  456. 4560  IF I=2 THEN GOSUB 5070 :GOTO 4820 
  457. 4570  IF I=11 THEN 4820 
  458. 4580  MK=2*PI
  459. 4590  GOSUB 4900 :M=S-INT(S/MK)*MK:MK=360
  460. 4600  GOSUB 4900 :E=S*180/PI
  461. 4610  EA=M:FOR I1=1 TO 5:EA=M+E*SIN(EA):NEXT I1
  462. 4620  READ AU
  463. 4630  E1=0.0172021/(AU^1.5*(1-E*COS(EA)))
  464. 4640  XW=-(AU*E1)*SIN(EA):YW=(AU*E1)*(1-E*E)^0.5*COS(EA)
  465. 4650  GOSUB 4900 :AP=S:GOSUB 4900 :AN=S
  466. 4660  GOSUB 4900 :NN=S
  467. 4670  X=XW:Y=YW:GOSUB 5040 
  468. 4680  XH=X:YH=Y:ZH=G
  469. 4690  MK=360:IF I=1 THEN XA=-XH:YA=-YH:ZA=-ZH:AB=0:GOTO 4710 
  470. 4700  XW=XH+XA:YW=YH+YA:ZW=ZH+ZA
  471. 4710  X=AU*(COS(EA)-E):Y=AU*SIN(EA)*(1-E*E)^0.5
  472. 4720  GOSUB 5040 :XX=X:YY=Y:ZZ=G
  473. 4730  IF I>5 AND I<11 THEN GOSUB 4980 :XX=XX+T(2):YY=YY+T(1):ZZ=ZZ+T(3)
  474. 4740  XK=(XX*YH-YY*XH)/(XX*XX+YY*YY)
  475. 4750  BR=0:GOSUB 4840 :AB=1
  476. 4760  'CH(I)=SS:CL(I)=C
  477. 4770  IF I=1 THEN X1=XX:Y1=YY:Z1=ZZ:GOTO 4800 
  478. 4780  XX=XX-X1:YY=YY-Y1:ZZ=ZZ-Z1
  479. 4790  XK=(XX*YW-YY*XW)/(XX*XX+YY*YY)
  480. 4800  BR=0.0057683*SQR(XX*XX+YY*YY+ZZ*ZZ)*XK*180/PI:' ABERRATION
  481. 4810  GOSUB 4840 :PP(I)=SS:PD(I)=P:PM(I)=XK
  482. 4820  NEXT I
  483. 4830  RETURN :'****** END OF PLANETS ROUTINE
  484. 4840  X=XX:Y=YY:GOSUB 4930 :K=A:C=A*180/PI+NU+BR:IF I=1 AND AB=1 THEN C=(C+180)-INT((C+180)/MK)*MK:MK=360
  485. 4850  C=(C+SD)-INT((C+SD)/MK)*MK:MK=360:SS=C:Y=ZZ:X=R:GOSUB 4930 :IF A>0.35 THEN A=A-2*PI
  486. 4860  P=A*180/PI
  487. 4870  IF P>180 THEN P=P-360:GOTO 4870
  488. 4880  IF P<-180 THEN P=P+360:GOTO 4880
  489. 4890  RETURN
  490. 4900  READ S,S1,S2:S=(S+S1*TC+S2*TC*TC)*PI/180:RETURN
  491. 4910  IF A=0 THEN A=0
  492. 4920  X=R*COS(A):Y=R*SIN(A):RETURN
  493. 4930  IF Y=0 THEN Y=0
  494. 4940  R=(X*X+Y*Y)^0.5
  495. 4950  A=ATN(Y/X):IF A<0 THEN A=A+PI
  496. 4960  IF Y<0 THEN A=A+PI
  497. 4970  RETURN
  498. 4980  K(6)=11:K(7)=5:K(8)=4:K(10)=4:K(9)=4:'NUMBER OF HARMONIC TERMS FOR PLANET
  499. 4990  FOR IK=1 TO 3:IF I=6 AND IK=3 THEN T(3)=0:RETURN
  500. 5000  IF IK=3 THEN K(I)=K(I)-1
  501. 5010  'ASSEMBLE TERMS
  502. 5020  GOSUB 4900 :A=0:FOR IJ=1 TO K(I):READ U,V,W
  503. 5030  A=A+U*(PI/180)*COS((V*TC+W)*PI/180):NEXT IJ:T(IK)=(S+A)*180/PI:NEXT IK:RETURN
  504. 5040  GOSUB 4930 :A=A+AP:GOSUB 4910 :D=X:X=Y:Y=0:GOSUB 4930 :A=A+NN:GOSUB 4910 :G=Y:Y=X:X=D
  505. 5050  GOSUB 4930 :A=A+AN:IF A<0 THEN A=A+2*PI
  506. 5060  GOSUB 4910 :RETURN
  507. 5070  'MOON
  508. 5080  LL=973563+1.73256E+09*TC-4*TC*TC
  509. 5090  G=1.0124E+06+6189*TC
  510. 5100  N=933060-6.96291E+06*TC+7.5*TC*TC
  511. 5110  G1=1.20359E+06+1.46485E+07*TC-37*TC*TC
  512. 5120  D=1.26266E+06+1.60296E+09*TC-5*TC*TC:M=3600
  513. 5130  L=(LL-G1)/M:L1=((LL-D)-G)/M:F=(LL-N)/M:D=D/M:Y=2*D
  514. 5140  ML=0:A=22639.6:B=L:GOSUB 5310 :A=-4586.47:B=L-Y:GOSUB 5310 
  515. 5150  A=2369.91:B=Y:GOSUB 5310 :A=769:B=2*L:GOSUB 5310 :A=-668.147:B=L1:GOSUB 5310 
  516. 5160  A=-411.608:B=2*F:GOSUB 5310 :A=-211.656:B=2*L-Y:GOSUB 5310 
  517. 5170  A=-205.962:B=L+L1-Y:GOSUB 5310 :A=191.953:B=L+Y:GOSUB 5310 
  518. 5180  A=-165.145:B=L1-Y:GOSUB 5310 :A=147.687:B=L-L1:GOSUB 5310 :A=-125.154:B=D:GOSUB 5310 
  519. 5190  A=-109.673:B=L+L1:GOSUB 5310 :A=-55.173:B=2*F-Y:GOSUB 5310 
  520. 5200  A=-45.099:B=L+2*F:GOSUB 5310 :A=39.529:B=L-2*F:GOSUB 5310 
  521. 5210  A=-38.428:B=L-2*Y:GOSUB 5310 :A=36.124:B=3*L:GOSUB 5310 
  522. 5220  A=-30.773:B=2*L-2*Y:GOSUB 5310 :A=28.475:B=L-L1-Y:GOSUB 5310 
  523. 5230  A=-24.42:B=L1+Y:GOSUB 5310:A=18.609:B=L-D:GOSUB 5310 
  524. 5240  A=-8.466:B=L+D:GOSUB 5310 
  525. 5250  PP(2)=((LL+ML)/M)-INT(((LL+ML)/M)/360)*360
  526. 5260  ML=N:A=5392:B=2*F-Y:GOSUB 5310 :A=-541:B=L1:GOSUB 5310 :A=-442:B=Y:GOSUB 5310 
  527. 5270  A=423:B=2*F:GOSUB 5310 :A=-291:B=2*L-2*F:GOSUB 5310 
  528. 5280  PP(11)=(ML/M)-INT((ML/M)/360)*360
  529. 5290  GOSUB 5320 
  530. 5300  RETURN
  531. 5310  ML=ML+A*SIN(PI/180*B):RETURN
  532. 5320  'MOONS DECL
  533. 5330  ML=0:A=18461.5:B=F:GOSUB 5310 :A=1010:B=L+F:GOSUB 5310 :A=-999:B=F-L:GOSUB 5310 
  534. 5340  A=-624:B=F-Y:GOSUB 5310 :A=199:B=F+Y-L:GOSUB 5310 
  535. 5350  A=-167:B=L+F-Y:GOSUB 5310 :A=117:B=F+Y:GOSUB 5310 
  536. 5360  A=62:B=2*L+F:GOSUB 5310 :A=-33:B=F-Y-L:GOSUB 5310 
  537. 5370  A=-32:B=F-2*L:GOSUB 5310 :A=-30:B=L1+F-Y:GOSUB 5310 
  538. 5380  PD(2)=SGN(ML)*((ABS(ML)/M)/360-INT((ABS(ML)/M)/360))*360
  539. 5390  RETURN
  540. 5400  PRINT"WRITE DISK FILE":PRINT:INPUT"WHAT IS THE NEW FILENAME (OR QUIT)";A$
  541. 5405  IF A$="" THEN 5400
  542. 5406  FOR I=1 TO LEN(A$):MID$(A$,I,1)=FNL$(MID$(A$,I,1)):NEXT
  543. 5410  IF A$="QUIT" THEN RETURN
  544. 5420  ON ERROR GOTO 5440:OPEN "O",1,A$:ON ERROR GOTO 0
  545. 5430  GOTO 5450
  546. 5440  CLOSE#1:PRINT"I CANNOT OPEN ";A$:RESUME 5400
  547. 5450  FOR I=1 TO 2
  548. 5460  PRINT"WRITING COPY NUMBER ";I
  549. 5470  WRITE#1,NA$,LA,LO,GT,JD,TC,MO,DA,YE,NP,DS$,HO,MI,SE,LT$,PL$
  550. 5480  WRITE#1,PP(1),PP(2),PP(3),PP(4),PP(5),PP(6),PP(7),PP(8),PP(9),PP(10),PP(11),PP(12),PP(13)
  551. 5490  WRITE#1,PD(1),PD(2),PD(3),PD(4),PD(5),PD(6),PD(7),PD(8),PD(9),PD(10),PD(11),PD(12),PD(13)
  552. 5500  WRITE#1,PM(1),PM(2),PM(3),PM(4),PM(5),PM(6),PM(7),PM(8),PM(9),PM(10),PM(11),PM(12),PM(13)
  553. 5510  WRITE#1,PP(14),PP(15),PD(14),PD(15),PM(14),PM(15),AD,LA$,AM,BD,LO$,BM,ST
  554. 5520  NEXT I
  555. 5530  CLOSE#1
  556. 5540  RETURN
  557. 5550  GOSUB 5560:IF A$="QUIT" THEN RETURN ELSE GOSUB 5690:RETURN 'READ DISK AND GET HOUSE SYSTEM
  558. 5560  PRINT "READ DISK":PRINT:INPUT"WHAT IS THE FILENAME (OR QUIT)";A$
  559. 5562  IF A$="" THEN 5560
  560. 5564  FOR I=1 TO LEN(A$):MID$(A$,I,1)=FNL$(MID$(A$,I,1)):NEXT
  561. 5570  IF A$="QUIT" THEN RETURN
  562. 5580  ON ERROR GOTO 5600:OPEN "I",1,A$:ON ERROR GOTO 0
  563. 5590  GOTO 5610
  564. 5600  CLOSE#1:PRINT"I CANNOT OPEN ";A$:RESUME 5560
  565. 5610  PRINT"I'M NOW READING THE DISK FILE."
  566. 5620  INPUT#1,NA$,LA,LO,GT,JD,TC,MO,DA,YE,NP,DS$,HO,MI,SE,LT$,PL$:GOSUB 5710
  567. 5630  INPUT#1,PP(1),PP(2),PP(3),PP(4),PP(5),PP(6),PP(7),PP(8),PP(9),PP(10),PP(11),PP(12),PP(13):GOSUB 5710 
  568. 5640  INPUT#1,PD(1),PD(2),PD(3),PD(4),PD(5),PD(6),PD(7),PD(8),PD(9),PD(10),PD(11),PD(12),PD(13):GOSUB 5710 
  569. 5650  INPUT#1,PM(1),PM(2),PM(3),PM(4),PM(5),PM(6),PM(7),PM(8),PM(9),PM(10),PM(11),PM(12),PM(13):GOSUB 5710 
  570. 5660  INPUT#1,PP(14),PP(15),PD(14),PD(15),PM(14),PM(15),AD,LA$,AM,BD,LO$,BM,ST:GOSUB 5710 
  571. 5670  CLOSE#1:PRINT
  572. 5680  RETURN
  573. 5690  GOSUB 1700:GOSUB 1790:GOSUB 1820'GET HOUSE SYSTEM, ST & OB, COMPUTE CUSPS
  574. 5700  RETURN
  575. 5710  PRINT" * ";:RETURN
  576. 5720  PRINT:PRINT:PRINT"SORTING...";
  577. 5730  FOR I=1 TO 12
  578. 5740    PS(I,1)=I
  579. 5750    PS(I,2)=CU(I)
  580. 5760    PRINT ".";
  581. 5770  NEXT
  582. 5780  FOR I=1 TO NP
  583. 5790    PS(12+I,1)=12+I
  584. 5800    PS(12+I,2)=PP(I)
  585. 5810    PRINT ".";
  586. 5820  NEXT
  587. 5830  I2=12+NP
  588. 5840  FOR I=1 TO 12+NP-1
  589. 5850    FOR I1 = I+1 TO 12+NP
  590. 5860      PRINT ".";
  591. 5870      IF PS(I1,2)<PS(I,2) THEN X1=PS(I1,1):X2=PS(I1,2):<UNK! {0009}><UNK! {0009}><UNK! {0009}>PS(I1,1)=PS(I,1):PS(I1,2)=PS(I,2):PS(I,1)=X1:PS(I,2)=X2
  592. 5880    NEXT I1
  593. 5890    IF PS(I,1)=1 THEN I2=I
  594. 5900  NEXT I
  595. 5910  PRINT "."
  596. 5920  PRINT:PRINT:IF LP=1 THEN PRINT #2,:PRINT #2,
  597. 5930  FOR I1=1 TO 12+NP
  598. 5940    I=I1+I2-1:IF I>12+NP THEN I=I-12-NP
  599. 5950    S=PS(I,2):GOSUB 2240:'CONVERT SIGN TO ASCII
  600. 5960    IF PS(I,1)<13 THEN PRINT CU$(PS(I,1));S$:ELSE PRINT "    ";PN$(PS(I,1)-12);S$;:IF PM(PS(I,1)-12)<0 THEN PRINT " RX" ELSE PRINT " "
  601. 5970   IF LP=1 THEN IF PS(I,1)<13 THEN PRINT #2, S$,CU$(PS(I,1)):ELSE PRINT #2,S$,PN$(PS(I,1)-12):IF PM(PS(I,1)-12)<0 THEN PRINT #2, " RX" ELSE PRINT #2,
  602. 5980   IF INT(I1/15)=I1/15 THEN GOSUB 740
  603. 5990  NEXT I1
  604. 6000  GOSUB 740
  605. 6010  RETURN
  606. 6020  'LIST MIDPOINTS
  607. 6030  PRINT:PRINT:IF LP=1 THEN PRINT #2,:PRINT #2,
  608. 6040  FOR I=1 TO NP
  609. 6050    PC(I)=PP(I)
  610. 6060  NEXT I
  611. 6070  IK=0:'CLEAR SCREEN SET LINE COUNTER
  612. 6080  FOR I1=1 TO NP-1
  613. 6090    PRINT "**** ";PN$(I1);"'S MIDPOINTS ****"
  614. 6100    IF LP=1 THEN PRINT #2,"**** ";PN$(I1);"'S MIDPOINTS ****"
  615. 6110    IF LP=0 THEN IK=IK+1:IF INT(IK/15)=IK/15 THEN IK=0:GOSUB 740
  616. 6120    FOR I2=I1+1 TO NP
  617. 6130      S=(PP(I1)+PC(I2))/2
  618. 6140      IF ABS(PP(I1)-PC(I2))>180 THEN S=S-180
  619. 6150      IF S<0 THEN S=S+360
  620. 6160      GOSUB 2240:PRINT PN$(I1)"- "PN$(I2);TAB(25);S$
  621. 6170      IF LP=1 THEN PRINT #2, S$,PN$(I1),PN$(I2)
  622. 6180      IF LP=0 THEN IK=IK+1:IF INT(IK/15)=IK/15 THEN IK=0:GOSUB 740
  623. 6190    NEXT I2
  624. 6200  NEXT I1
  625. 6210  GOSUB 740
  626. 6220  RETURN
  627. 6230  PRINT:PRINT"HERE IS A LIST OF YOUR DISK FILES:":PRINT
  628. 6240  FILES "*.*"
  629. 6250  PRINT:PRINT
  630. 6260  GOSUB 740
  631. 6270  RETURN
  632.